home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / OTHER_LA / YERK__ / TOOLBOX_ / INTERVAL < prev    next >
Text File  |  1990-12-14  |  1KB  |  52 lines
  1. \ interval  - interval timer stuff
  2. \ 12/14/84  cbd Version 1
  3. \ 10/15/85  cdn Fixed print: method in Timer
  4. \  1/31/87    rfl added clear:
  5. \  6/13/89    rfl added pause
  6. \ 12/12/90    rfl    modified when: to not depend on events...looks at global 'ticks'
  7. \                also changed pause and wait to >= compares
  8. Decimal
  9.  
  10. \ define an interval timer class
  11. :CLASS Timer  <Super Object
  12.  
  13.     Var        Ticks    \ store system ticks=60ths
  14.     Int        On        \ true = timing
  15.  
  16.     \ ( -- ticks )  return system ticks
  17.     :M  WHEN:  global ticks @   ;M
  18.  
  19.     \ start timing an interval
  20.     :M  START:  when: self put: ticks  1 put: on  ;M
  21.  
  22.     \ stop the clock, and replace ticks with the interval
  23.     :M  STOP:   when: self get: ticks - put: ticks  clear: on ;M
  24.  
  25.     \ ( -- secs*60 ) get the current value of the clock, but keep timing if on
  26.     :M  GET:  get: on
  27.         IF  when: self  get: ticks -
  28.         ELSE  get: ticks  THEN  ;M
  29.  
  30.     \ print the current value of the timer, in seconds and hundredths
  31.     :M  PRINT:  get: self  60 /mod 3 .R  $ 2e emit  100 * 60 /
  32.         2 .R ."  Seconds " ;M
  33.  
  34.     :M  CLEAR: clear: on clear: ticks ;M
  35.  
  36. ;CLASS
  37.  
  38. Timer sysTimer    \ create an instance of Timer
  39.  
  40. \ ( -- f OR key t )  listen to event queue, true if key event
  41. : ?Key  next: fEvent  ;
  42.  
  43. \ general purpose pause where time is in 1/60ths of second - process events
  44. timer pTimer
  45. : pause { time -- } start: pTimer
  46.     BEGIN next: fevent IF 2drop THEN get: pTimer time >= UNTIL ;
  47.  
  48. \ same as pause, but don't process events
  49. : wait { time -- } start: pTimer
  50.     BEGIN get: pTimer time >= UNTIL ;
  51.  
  52.